home *** CD-ROM | disk | FTP | other *** search
/ POINT Software Programming / PPROG1.ISO / pascal / swag / ansi.swg / 0034_Full ANSI Unit.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1995-03-26  |  24.6 KB  |  625 lines
  1.  
  2. (*
  3.   A unit to implement FULL ANSI output.  Useful for a BBS or DOOR program
  4.   where you would want to send string out over the modem.  Simply call
  5.   your modem routine to :
  6.  
  7.              SENDSTRING(port,ANSIGoToXY(1,1))
  8.  
  9.   Would reposition the cursor on the remote terminal.  Get the idea ??
  10.  
  11.   The thing will EVEN play ANSI music !!
  12.  
  13.   Gayle Davis 1/24/94
  14.  
  15. 1) Added allowance for "esc[M " as a valid music prefix.  It is used
  16.    occasionally.
  17.  
  18. 2) Changed the effect of "esc[0m" from "NormVideo" to "textattr:=7",
  19.    which is what "esc[0m" literally means.  NormVideo just restores
  20.    startup colors, which could be anything.
  21.  
  22. 3) Added "HighVideo" line to take effect *immediately* when "esc[1m"
  23.    ("Bold") is encountered.  Otherwise, "esc[1m" by itself would not
  24.    activate "Bold".
  25.  
  26. 4) Changed "{blink on}" from "5 : textattr := textattr +  blink;"
  27. .                            "5 : textattr := textattr or blink;"
  28. .                                                      ^^
  29.    The "blink ON" was turning blink OFF when blink was turned ON
  30.    with blink already ON.
  31.  
  32. 5) Added "textattr and blink" to preserve blink status in the
  33.    "{general foregrounds}" subroutine.
  34.  
  35. 6) Changed default tempo assignment from "Min1:=120" to "Min1:=120/4"
  36.    in order to be consistent with the way the unit deals with tempo.
  37.  
  38. 7) Added an initialization line of "TextAttr:=7;" to allow for the
  39.    fact that some ANSI artists assume that the screen is normal white
  40.    on black to start with.  (My screen is NOT that color!)
  41.  
  42. DAVID DANIEL ANDERSON
  43. 09/08/94
  44.  
  45. *)
  46.  
  47. UNIT AnsiIO;
  48.  
  49. INTERFACE
  50.  
  51.    USES
  52.       CRT,
  53.       Graph3;  { GRAPH3.TPU is included in the BORLAND distribution diskettes }
  54.  
  55.    FUNCTION ANSIClrScr : string;
  56.    FUNCTION ANSIClrEol : string;
  57.    FUNCTION ANSIGotoXY(X, Y : word) : string;
  58.    FUNCTION ANSIUp(Lines : word) : string;
  59.    FUNCTION ANSIDown(Lines : word) : string;
  60.    FUNCTION ANSIRight(Cols : word) : string;
  61.    FUNCTION ANSILeft(Cols : word) : string;
  62.    FUNCTION ANSIColor(Fg, Bg : integer) : string;
  63.    FUNCTION ANSIMusic(s : string) : string;
  64.    PROCEDURE ANSIWrite(s : string);
  65.    PROCEDURE ANSIWriteLn(s : string);
  66.  
  67. IMPLEMENTATION
  68.  
  69.    CONST
  70.       ColorArray : array[0..7] of integer = (0,4,2,6,1,5,3,7);
  71.  
  72.    VAR
  73.       Bold, TruncateLines : boolean;
  74.       Vari, Octave, Numb : integer;
  75.       Test, Dly, Intern, DlyKeep : longInt;
  76.       Flager, ChartoPlay : char;
  77.       Typom, Min1, Adder : real;
  78.  
  79. {****************************************************************************}
  80. {***                                                                      ***}
  81. {***       Function that returns the ANSI code for a Clear Screen.        ***}
  82. {***                                                                      ***}
  83. {****************************************************************************}
  84.    FUNCTION ANSIClrScr : string;
  85.       BEGIN
  86.          ANSIClrScr := #27+'[2J';
  87.       END;
  88.  
  89. {****************************************************************************}
  90. {***                                                                      ***}
  91. {***    Function that returns the ANSI code for a Clear to End of Line.   ***}
  92. {***                                                                      ***}
  93. {****************************************************************************}
  94.    FUNCTION ANSIClrEol : string;
  95.       BEGIN
  96.          ANSIClrEol := #27+'[K';
  97.       END;
  98.  
  99. {****************************************************************************}
  100. {***                                                                      ***}
  101. {***   Function that returns the ANSI code to move the cursor to (X,Y).   ***}
  102. {***                                                                      ***}
  103. {****************************************************************************}
  104.    FUNCTION ANSIGotoXY(X, Y : word) : string;
  105.       VAR
  106.          XStr, YStr : string;
  107.  
  108.       BEGIN
  109.          str(X,XStr);
  110.          str(Y,YStr);
  111.          ANSIGotoXY := #27+'['+YStr+';'+XStr+'H';
  112.       END;
  113.  
  114. {****************************************************************************}
  115. {***                                                                      ***}
  116. {***  Function that returns the ANSI code to move the cursor up "Lines"   ***}
  117. {***                         number of lines.                             ***}
  118. {***                                                                      ***}
  119. {****************************************************************************}
  120.    FUNCTION ANSIUp(Lines : word) : string;
  121.       VAR
  122.          LinesStr : string;
  123.  
  124.       BEGIN
  125.          str(Lines,LinesStr);
  126.          ANSIUp := #27+'['+LinesStr+'A';
  127.       END;
  128.  
  129. {****************************************************************************}
  130. {***                                                                      ***}
  131. {***  Function that returns the ANSI code to move the cursor down "Lines" ***}
  132. {***                        number of lines.                              ***}
  133. {***                                                                      ***}
  134. {****************************************************************************}
  135.    FUNCTION ANSIDown(Lines : word) : string;
  136.       VAR
  137.          LinesStr : string;
  138.  
  139.       BEGIN
  140.          str(Lines,LinesStr);
  141.          ANSIDown := #27+'['+LinesStr+'B';
  142.       END;
  143.  
  144. {****************************************************************************}
  145. {***                                                                      ***}
  146. {***     Function that returns the ANSI code to move the cursor "Cols"    ***}
  147. {***                         positions forward.                           ***}
  148. {***                                                                      ***}
  149. {****************************************************************************}
  150.    FUNCTION ANSIRight(Cols : word) : string;
  151.       VAR
  152.          ColsStr : string;
  153.  
  154.       BEGIN
  155.          str(Cols,ColsStr);
  156.          ANSIRight := #27+'['+ColsStr+'C';
  157.       END;
  158.  
  159. {****************************************************************************}
  160. {***                                                                      ***}
  161. {***     Function that returns the ANSI code to move the cursor "Cols"    ***}
  162. {***                        positions backward.                           ***}
  163. {***                                                                      ***}
  164. {****************************************************************************}
  165.    FUNCTION ANSILeft(Cols : word) : string;
  166.       VAR
  167.          ColsStr : string;
  168.  
  169.       BEGIN
  170.          str(Cols,ColsStr);
  171.          ANSILeft := #27+'['+ColsStr+'D';
  172.       END;
  173.  
  174.  
  175. {****************************************************************************}
  176. {***                                                                      ***}
  177. {***    Function that returns the ANSI code to change the screen color    ***}
  178. {***             to an "Fg" foreground and a "Bg" background.             ***}
  179. {***                                                                      ***}
  180. {****************************************************************************}
  181.    FUNCTION ANSIColor(Fg, Bg : integer) : string;
  182.       VAR
  183.          FgStr, BgStr, Temp : string;
  184.  
  185.       BEGIN
  186.          str(ColorArray[Fg mod 8] + 30, FgStr);
  187.          str(ColorArray[Bg mod 8] + 40, BgStr);
  188.          Temp := #27+'[';
  189.          if Bg > 7 then
  190.             Temp := Temp+'5;'
  191.          else
  192.             Temp := Temp+'0;';
  193.          if Fg > 7 then
  194.             Temp := Temp+'1;'
  195.          else
  196.             Temp := Temp+'2;';
  197.          ANSIColor := Temp+FgStr+';'+BgStr+'m';
  198.       END;
  199.  
  200. {****************************************************************************}
  201. {***                                                                      ***}
  202. {*** Function that returns an ANSI code representing a music string ("s") ***}
  203. {***                                                                      ***}
  204. {****************************************************************************}
  205.    FUNCTION ANSIMusic(s : string) : string;
  206.  
  207.       BEGIN
  208.          ANSIMusic := #27+'[MF'+s+#14;
  209.       END;
  210.  
  211. {****************************************************************************}
  212. {***                                                                      ***}
  213. {***  Procedure that simulates BASIC's "PLAY" procedure.  Will also work  ***}
  214. {***      with ANSI codes.  Taken from PC Magazine Volume 9 Number 3      ***}
  215. {***                                                                      ***}
  216. {****************************************************************************}
  217.    PROCEDURE Play(SoundC : string);
  218.       FUNCTION IsNumber(ch : char) : boolean;
  219.          BEGIN
  220.             IsNumber := (CH >= '0') AND (CH <= '9');
  221.          END;
  222.  
  223.    {Converts a string to an integer}
  224.       FUNCTION value(s : string) : integer;
  225.          VAR
  226.             ss, sss : integer;
  227.          BEGIN
  228.             Val(s, ss, sss);
  229.             value := ss;
  230.          END;
  231.  
  232.    {Plays the selected note}
  233.       PROCEDURE sounder(key : char; flag : char);
  234.          VAR
  235.             old, New, new2 : Real;
  236.          BEGIN
  237.             adder := 1;
  238.             old := dly;
  239.             New := dly;
  240.             intern := Pos(key, 'C D E F G A B')-1;
  241.             IF (flag = '+') AND (key <> 'E') AND (key <> 'B') {See if note}
  242.                THEN Inc(intern);                              {is sharped }
  243.             IF (flag = '-') AND (key <> 'F') AND (key <> 'C')
  244.                THEN Dec(intern);                              {or a flat. }
  245.             WHILE SoundC[vari+1] = '.' DO
  246.                BEGIN
  247.                   Inc(vari);
  248.                   adder := adder/2;
  249.                   New := New+(old*adder);
  250.                END;
  251.             new2 := (New/typom)*(1-typom);
  252.             sound(Round(Exp((octave+intern/12)*Ln(2)))); {Play the note}
  253.             Delay(Trunc(New));
  254.             Nosound;
  255.             Delay(Trunc(new2));
  256.          END;
  257.  
  258.    {Calculate delay for a specified note length}
  259.       FUNCTION delayer1 : integer;
  260.          BEGIN
  261.             numb := value(SoundC[vari+1]);
  262.             delayer1 := Trunc((60000/(numb*min1))*typom);
  263.          END;
  264.  
  265.    {Used as above, except reads a number >10}
  266.  
  267.       FUNCTION delayer2 : Integer;
  268.          BEGIN
  269.             numb := value(SoundC[vari+1]+SoundC[vari+2]);
  270.             delayer2 := Trunc((60000/(numb*min1))*typom);
  271.          END;
  272.  
  273.       BEGIN                           {Play}
  274.          SoundC := SoundC+' ';
  275.          FOR vari := 1 TO Length(SoundC) DO
  276.             BEGIN                     {Go through entire string}
  277.                SoundC[vari] := Upcase(SoundC[vari]);
  278.                CASE SoundC[vari] OF
  279. {Check to see}    'C','D','E',
  280. {if char is a}    'F','G','A',
  281. {note}            'B' : BEGIN
  282.                            flager := ' ';
  283.                            dlykeep := dly;
  284.                            chartoplay := SoundC[vari];
  285.                            IF (SoundC[vari+1] = '-') OR
  286.                               (SoundC[vari+1] = '+') THEN
  287. {Check for flats & sharps}    BEGIN
  288.                                  flager := SoundC[vari+1];
  289.                                  Inc(vari);
  290.                               END;
  291.                            IF IsNumber(SoundC[vari+1]) THEN
  292.                               BEGIN
  293.                                  IF IsNumber(SoundC[vari+2]) THEN
  294.                                     BEGIN
  295.                                        test := delayer2;
  296. {Make sure # is legal}                 IF numb < 65 THEN
  297.                                           dly := test;
  298.                                        Inc(vari, 2);
  299.                                     END
  300.                                  ELSE
  301.                                     BEGIN
  302.                                        test := delayer1;
  303. {Make sure # is legal}                 IF numb > 0 THEN
  304.                                           dly := test;
  305.                                        Inc(vari);
  306.                                     END;
  307.                               END;
  308.                            sounder(chartoplay, flager);
  309.                            dly := dlykeep;
  310.                         END;
  311. {Check for}       'O' : BEGIN
  312. {octave change}            Inc(vari);
  313.                            CASE SoundC[vari] OF
  314.                               '-' : IF octave > 1 THEN Dec(octave);
  315.                               '+' : IF octave < 7 THEN Inc(octave);
  316.                               '1','2','3',
  317.                               '4','5','6',
  318.                               '7' : octave := value(SoundC[vari])+4;
  319.                            ELSE Dec(vari);
  320.                            END;
  321.                         END;
  322. {Check for a}     'L' : IF IsNumber(SoundC[vari+1]) THEN
  323. {change in length}         BEGIN
  324. {for notes}                   IF IsNumber(SoundC[vari+2]) THEN
  325.                                  BEGIN
  326.                                     test := delayer2;
  327.                                     IF numb < 65 THEN
  328. {Make sure # is legal}                 dly := test;
  329.                                     Inc(vari, 2);
  330.                                  END
  331.                               ELSE
  332.                                  BEGIN
  333.                                     test := delayer1;
  334.                                     IF numb > 0 THEN
  335. {Make sure # is legal}                 dly := test;
  336.                                     Inc(vari);
  337.                                  END;
  338.                            END;
  339. {Check for pause} 'P' : IF IsNumber(SoundC[vari+1]) THEN
  340. {and it's length}          BEGIN
  341.                               IF IsNumber(SoundC[vari+2]) THEN
  342.                                  BEGIN
  343.                                     test := delayer2;
  344.                                     IF numb < 65 THEN
  345. {Make sure # is legal}                 Delay(test);
  346.                                     Inc(vari, 2);
  347.                                  END
  348.                               ELSE
  349.                                  BEGIN
  350.                                     test := delayer1;
  351.                                     IF numb > 0 THEN
  352. {Make sure # is legal}                 Delay(test);
  353.                                     Inc(vari);
  354.                                  END;
  355.                            END;
  356. {Check for}       'T' : IF IsNumber(SoundC[vari+1]) AND
  357. {tempo change}             IsNumber(SoundC[vari+2]) THEN
  358.                            BEGIN
  359.                               IF IsNumber(SoundC[vari+3]) THEN
  360.                                  BEGIN
  361.                                     min1 := value(SoundC[vari+1]+
  362.                                             SoundC[vari+2]+SoundC[vari+3]);
  363.                                     Inc(vari, 3);
  364.                                     IF min1 > 255 THEN
  365. {Make sure # isn't too big}            min1 := 255;
  366.                                  END
  367.                               ELSE
  368.                                  BEGIN
  369.                                     min1 := value(SoundC[vari+1]+
  370.                                             SoundC[vari+2]);
  371.                                     IF min1 < 32 THEN
  372. {Make sure # isn't too small}          min1 := 32;
  373.                                  END;
  374.                               min1 := min1/4;
  375.                            END;
  376. {Check for music} 'M' : BEGIN
  377. {type}                     Inc(vari);
  378.                            CASE Upcase(SoundC[vari]) OF
  379. {Normal}                      'N' : typom := 7/8;
  380. {Legato}                      'L' : typom := 1;
  381. {Staccato}                    'S' : typom := 3/4;
  382.                            END;
  383.                         END;
  384.                END;
  385.             END;
  386.       END;
  387.  
  388. {****************************************************************************}
  389. {***                                                                      ***}
  390. {***    Procedure to process string "s" and write its contents to the     ***}
  391. {***          screen, interpreting ANSI codes as it goes along.           ***}
  392. {***                                                                      ***}
  393. {****************************************************************************}
  394.    PROCEDURE ANSIWrite(s : string);
  395.       VAR
  396.          SaveX, SaveY : byte;
  397.          MusicStr : string;
  398.          MusicPos : integer;
  399.  
  400.    {*** Procedure to process the actual ANSI sequence ***}
  401.       PROCEDURE ProcessEsc;
  402.          VAR
  403.             DeleteNum : integer;
  404.             ts : string[5];
  405.             Num : array[0..10] of shortint;
  406.             Color : integer;
  407.  
  408.          LABEL
  409.             loop;
  410.  
  411.       {*** Procedure to extract a parameter from the ANSI sequence and ***}
  412.       {*** place it in "Num" ***}
  413.          PROCEDURE GetNum(cx : byte);
  414.             VAR
  415.                code : integer;
  416.             BEGIN
  417.                ts := '';
  418.                WHILE (s[1] in ['0'..'9']) and (length(s) > 0) DO
  419.                   BEGIN
  420.                      ts := ts + s[1];
  421.                      Delete(s,1,1);
  422.                   END;
  423.                val(ts,Num[cx],code)
  424.             END;
  425.  
  426.          BEGIN
  427.             IF s[2] <> '[' THEN exit;
  428.             Delete(s,1,2);
  429.             IF (UpCase(s[1]) = 'M') and (UpCase(s[2]) in ['F','B',#32]) THEN
  430. {| Added allowance for "esc[M " as a valid music prefix in line above. DDA|}
  431.  
  432. {play music}   BEGIN
  433.                   Delete(s,1,2);
  434.                   MusicPos := pos(#14,s);
  435.                   Play(copy(s,1,MusicPos-1));
  436.                   DeleteNum := MusicPos;
  437.                   Goto Loop;
  438.                END;
  439.             fillchar(Num,sizeof(Num),#0);
  440.             GetNum(0);
  441.             DeleteNum := 1;
  442.             WHILE (s[1] = ';') and (DeleteNum < 11) DO
  443.                BEGIN
  444.                   Delete(s,1,1);
  445.                   GetNum(DeleteNum);
  446.                   DeleteNum  := DeleteNum + 1;
  447.                END;
  448.             CASE UpCase(s[1]) of
  449. {move up}      'A' : BEGIN
  450.                         if Num[0] = 0 THEN
  451.                            Num[0] := 1;
  452.                         WHILE Num[0] > 0 DO
  453.                            BEGIN
  454.                               GotoXY(wherex,wherey - 1);
  455.                               Num[0] := Num[0] - 1;
  456.                            END;
  457.                         DeleteNum := 1;
  458.                      END;
  459. {move down}    'B' : BEGIN
  460.                         if Num[0] = 0 THEN
  461.                            Num[0] := 1;
  462.                         WHILE Num[0] > 0 DO
  463.                            BEGIN
  464.                               GotoXY(wherex,wherey + 1);
  465.                               Num[0] := Num[0] - 1;
  466.                            END;
  467.                         DeleteNum := 1;
  468.                      END;
  469. {move right}   'C' : BEGIN
  470.                         if Num[0] = 0 THEN
  471.                            Num[0] := 1;
  472.                         WHILE Num[0] > 0 DO
  473.                            BEGIN
  474.                               GotoXY(wherex + 1,wherey);
  475.                               Num[0] := Num[0] - 1;
  476.                            END;
  477.                         DeleteNum := 1;
  478.                      END;
  479. {move left}    'D' : BEGIN
  480.                         if Num[0] = 0 THEN
  481.                            Num[0] := 1;
  482.                         WHILE Num[0] > 0 DO
  483.                            BEGIN
  484.                               GotoXY(wherex - 1,wherey);
  485.                               Num[0] := Num[0] - 1;
  486.                            END;
  487.                         DeleteNum := 1;
  488.                      END;
  489. {goto x,y}     'H',
  490.                'F' : BEGIN
  491.                         if (Num[0] = 0) THEN
  492.                            Num[0] := 1;
  493.                         if (Num[1] = 0) THEN
  494.                            Num[1] := 1;
  495.                         GotoXY(Num[1],Num[0]);
  496.                         DeleteNum := 1;
  497.                      END;
  498. {save current} 'S' : BEGIN
  499. {position}              SaveX := wherex;
  500.                         SaveY := wherey;
  501.                         DeleteNum := 1;
  502.                      END;
  503. {restore}      'U' : BEGIN
  504. {saved position}        GotoXY(SaveX,SaveY);
  505.                         DeleteNum := 1;
  506.                      END;
  507. {clear screen} 'J' : BEGIN
  508.                         if Num[0] = 2 THEN
  509.                            ClrScr;
  510.                         DeleteNum := 1;
  511.                      END;
  512. {clear from}   'K' : BEGIN
  513. {cursor position}       ClrEOL;
  514. {to end of line}        DeleteNum := 1;
  515.                      END;
  516. {change}       'M' : BEGIN
  517. {colors and}            DeleteNum := 0;
  518. {attributes}            WHILE (Num[DeleteNum] <> 0) or (DeleteNum = 0) DO
  519.                            BEGIN
  520.                               CASE Num[DeleteNum] of
  521. {all attributes off}             0 : BEGIN
  522. {ie. normal white on black}             textattr:=7;
  523. {| Changed above line from "NormVideo", which only resets attributes to
  524.    whatever the cursor attribute at startup was.  Changed to textattr:=7
  525.    since "esc[0..m" actually equals "textattr:=7". DDA|}
  526.  
  527.                                         Bold := false;
  528.                                      END;
  529. {bold on}                        1 : BEGIN
  530.                                         Bold := true;
  531.                                         HighVideo;
  532. {| Added "HighVideo" line, since "esc[1m" by itself would not otherwise
  533.    activate "Bold". DDA|}
  534.  
  535.                                      END;
  536. {blink on}                       5 : textattr := textattr or blink;
  537. {| Changed from "textattr+blink", which would turn blink off if it was
  538.    already on. DDA|}
  539.  
  540. {reverse on}                     7 : textattr := ((textattr and $07) shl 4) +
  541.                                      ((textattr and $70) shr 4);
  542. {invisible on}                   8 : textattr := 0;
  543. {general foregrounds}            30..
  544.                                  37 : BEGIN
  545.                                          color := ColorArray[Num[DeleteNum]
  546.                                                   - 30];
  547.                                          IF Bold THEN
  548.                                             color := color + 8;
  549.                                          textcolor((textattr and blink)+color);
  550. {| Added "textattr and blink" to preserve blink status. DDA|}
  551.  
  552.                                       END;
  553. {general backgrounds}            40..
  554.                                  47 : textbackground(
  555.                                       ColorArray[Num[DeleteNum] - 40]);
  556.                               END;
  557.                               DeleteNum := DeleteNum + 1;
  558.                            END;
  559.                         DeleteNum := 1;
  560.                      END;
  561. {change text}  '=',
  562. {modes}        '?' : BEGIN
  563.                         Delete(s,1,1);
  564.                         GetNum(0);
  565.                         if UpCase(s[1]) = 'H' THEN
  566.                            BEGIN
  567.                               CASE Num[0] of
  568.                                  0 : TextMode(bw40);
  569.                                  1 : TextMode(co40);
  570.                                  2 : TextMode(bw80);
  571.                                  3 : TextMode(co80);
  572.                                  4 : GraphColorMode;
  573.                                  5 : GraphMode;
  574.                                  6 : HiRes;
  575.                                  7 : TruncateLines := false;
  576.                               END;
  577.                            END;
  578.                         if UpCase(s[1]) = 'L' THEN
  579.                            if Num[0] = 7 THEN
  580.                               TruncateLines := true;
  581.                         DeleteNum := 1;
  582.                      END;
  583.             END;
  584. loop:       Delete(s,1,DeleteNum);
  585.          END;
  586.  
  587.       BEGIN
  588.          WHILE length(s) > 0 DO
  589.             BEGIN
  590.                if s[1] = #27 THEN
  591.                   ProcessEsc
  592.                else
  593.                   BEGIN
  594.                      Write(s[1]);
  595.                      Delete(s,1,1);
  596.                   END;
  597.             END;
  598.       END;
  599.  
  600. {****************************************************************************}
  601. {***                                                                      ***}
  602. {***         Procedure that calls ANSIWrite, then line feeds.             ***}
  603. {***                                                                      ***}
  604. {****************************************************************************}
  605.    PROCEDURE ANSIWriteLn(s : string);
  606.       BEGIN
  607.          ANSIWrite(s);
  608.          WriteLn;
  609.       END;
  610.  
  611.    BEGIN
  612.       Octave := 4;
  613.       ChartoPlay := 'N';
  614.       Typom := 7/8;
  615.       Min1 := 120/4;
  616. {| Added "/4" to be consistent with the part of the "Play" procedure
  617.    that reads and sets the tempo. DDA|}
  618.  
  619.       TruncateLines := false;
  620.       TextAttr:=7;
  621. {| Added above line to account for the fact that some ANSI artists just
  622.    assume that the screen is normal white on black to start with.  DDA|}
  623.  
  624.    END.
  625.